home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / comm / aprs403x.zip / MAPFIX.BAS < prev    next >
BASIC Source File  |  1994-03-06  |  54KB  |  1,178 lines
  1. REM MAPFIX.bas PROGRAM.  SEE EXPLAINATION BELOW
  2. REM
  3. Ver$ = "4.00B"
  4. MaxNumMAPS = 120'was 99 Current maximum number of maps loaded by APRS
  5. MaxNumPoints = 1500 'was 1000
  6. MaxNumLABELS = 99 'was 99
  7. MaxNumLines = 900
  8. REM $DYNAMIC
  9. GOTO BEGIN
  10.  
  11. Info: COLOR 15, 4: CLS
  12.    PRINT " MAPFIX.bas VERSION "; Ver$; " PROGRAM FOR FIXING APRS MAPS": PRINT
  13.    PRINT " This program has evolved significantly.  305 added a TRIM command to eliminate"
  14.    PRINT " all points outside an area.  3.07B adds W7KKE's GPS track history overlays and"
  15.    PRINT " digitizer code for using a drawing tablet.  308 fixed a filename bug.  Now in"
  16.    PRINT " 312, it will take USGS data from the 2,000,000:1 CD ROM and build APRS maps!"
  17.    PRINT " BUT NOT EASILY!  For a 50 mile map, there are 5 MBytes of USGS data which must"
  18.    PRINT " be filtered to get down to the 10K APRS size for the same area! The final steps"
  19.    PRINT " are all manual and take almost as long as developing an APRS map from scratch!"
  20.    PRINT
  21.    PRINT " CAUTION, THIS PROGRAM IS NOT PERFECT... KEEP BACKUPS!  Do a little at a time!"
  22.    PRINT
  23.    PRINT " Although MAPFIX has commands to make map modifications easier, a text EDITOR is"
  24.    PRINT " still useful for whole scale rearranging of points and features in a map file. "
  25.    PRINT
  26.    PRINT " MAPFIX uses two cursors.  The normal yellow APRS cursor, and a White MapPoint"
  27.    PRINT " which will be the next point to be processed.  ALT Keys allow you to MOVE the"
  28.    PRINT " MapPoint to the cursor, ADD a new point at the cursor, or DELETE the MapPoint."
  29.    PRINT " MAPFIX.bas shows you Deg/Min, Decimal, and APRS values of the cursor position."
  30.    PRINT
  31.    PRINT " ALSO NOTE THAT THE LIMITS IN APRS ARE 1000 POINTS, 99 FEATURES, and 99 LABELS!"
  32.    PRINT " If you need more points, features or labels, begin another map.";
  33.    LOCATE 25, 1: PRINT " HIT ANY KEY to continue...";
  34.    GOSUB GetChar: BEEP
  35.   
  36. Info2:   COLOR 15, 8: CLS
  37.    PRINT " PAGE 2 INSTRUCTIONS:  More about new features in version "; Ver$
  38.    PRINT
  39.    PRINT " With this new MAPFIX.bas, you can not only modify features by moving, adding"
  40.    PRINT " or deleting POINTS, but you can now add and kill FEATURES too, ie: roads,"
  41.    PRINT " rivers, borders, etc, from within the program.  In addition to the new KILL"
  42.    PRINT " and TRIM commands, the G key will move the cursor (GOTO) to the MapPoint,"
  43.    PRINT " and the F key will FIND the MapPoint nearest the cursor location.  If the"
  44.    PRINT " MapPointer and FeatureName get out of sequence, the RESET command may fix"
  45.    PRINT " them, but you should save the file immediately and check it with an editor."
  46.    PRINT
  47.    PRINT " I find the capability to delete points very useful when making larger area"
  48.    PRINT " maps from several smaller detail maps.  First, I run MAPCNVRT.bas to convert"
  49.    PRINT " all of the smaller maps to new temporary files with the new origin of the new"
  50.    PRINT " larger map.  Then I use the KILL command in MAPFIX to eliminate all minor "
  51.    PRINT " roads, features and labels and then the DELETE POINT command to remove all"
  52.    PRINT " inconsequential minor points from the roads that will not be needed"
  53.    PRINT " at the larger scale.  Then I use the editor to combine all of the points and"
  54.    PRINT " labels into the new file."
  55.    PRINT
  56.    PRINT " A new MAPLIST command shows your MAPLIST.map file; and the OTHER MAPS command"
  57.    PRINT " shows all MAP borders so you can see how your new map fits in.  You may use F3"
  58.    PRINT " and F4 keys to select smaller or larger map borders to draw."
  59.    PRINT
  60.    LOCATE 25, 1: PRINT " HIT ANY KEY to continue...";
  61.    GOSUB GetChar: BEEP
  62.   
  63. Info3:   COLOR 15, 3: CLS
  64.    PRINT " PAGE 3 INSTRUCTIONS:  Using GPS Track History Files to draw maps!"
  65.    PRINT
  66.    PRINT " To aid in creating accurate maps, W7KKE in California added routines to MAPFIX"
  67.    PRINT " so that you can overlay a Track History file onto the map you are constructing."
  68.    PRINT " This is an excellent tool for correcting your maps to real GPS data."
  69.    PRINT ""
  70.    PRINT " After you have loaded your map, type alt-G (GPS Track History') and enter the"
  71.    PRINT " history filename.  This will overlay the track history file.  You may then"
  72.    PRINT " use the normal MAPFIX.bas routines to move map segments and add so that the"
  73.    PRINT " map will agree with the GPS data contained in the track history file.  This"
  74.    PRINT " is especially useful with the history files saved by a laptop during mobile"
  75.    PRINT " GPS operations."
  76.    PRINT
  77.    PRINT " CAUTION:  Since GPS data is only accurate to 100 yards due to the effects of"
  78.    PRINT " Selective Availability, I would avoid using GPS data explicitely below about"
  79.    PRINT " the 2 mile range.  For this reason, I make the size of the GPS positions "
  80.    PRINT " expand below the 2 mile range to roughly approximate the size of the 100 yard"
  81.    PRINT " error circle."
  82.    PRINT
  83.    PRINT " Also note that you can now START a NEW map from scratch, without using the"
  84.    PRINT " text editor to enter the initial configuration data.  Just type NEW instread "
  85.    PRINT " of a MAPfilename when starting up the program."
  86.    LOCATE 25, 1: PRINT " HIT ANY KEY to continue...";
  87.    GOSUB GetChar: BEEP
  88.  
  89. Info4:   COLOR 15, 7: CLS
  90.    PRINT " PAGE 4 INSTRUCTIONS FOR USING A DIGITIZER:": PRINT
  91.    PRINT " In version 3.07B, MAPFIX.bas can now interface to a digitizer tablet or table"
  92.    PRINT " so that maps can be drawn directly from paper maps.  These routines were"
  93.    PRINT " developed by W7KKE and added to MAPFIX.bas in December 1993."
  94.    PRINT
  95.    PRINT " To use a digitizer, first you must hit the ALT-O command to open the COMM"
  96.    PRINT " PORT for the digitizer.  This command also lets you test the digitizer while"
  97.    PRINT " testing the alignment of the map on the digitizer surface.  It then prompts"
  98.    PRINT " you to identify the upper left and lower right corners of the map, in order"
  99.    PRINT " to calibrate the digitizer to the latitude, longitude and scale of the map."
  100.    PRINT
  101.    PRINT " From this point on, the button on the digitizer mouse is almost identical to"
  102.    PRINT " the ALT-A command for ADDing a point.  To start a new map feature, however,"
  103.    PRINT " for the digitizer, you DO NOT use the ALT-N NEW command, but you should use"
  104.    PRINT " the ALT-B BEGIN command.  For More information, see the README.DIG file."
  105.    PRINT
  106.    PRINT " To speed up the map drawing during editing, I no longer erase and re-draw"
  107.    PRINT " the entire map with each new point.  I simply draw just the new line segment."
  108.    PRINT " Sometimes, especially when you move, or add a line, this leaves an old line"
  109.    PRINT " segment, where there actually is no longer a line.  You can always celan up"
  110.    PRINT " the map by just hitting the space bar to force a new map..."
  111.    PRINT
  112.  
  113.   
  114.    Display$ = "UNKnown"
  115.    RETURN
  116.  
  117. GetChar: a$ = "": DO UNTIL a$ <> "": a$ = INKEY$: LOOP: RETURN
  118.  
  119. BEGIN: GOSUB Info:
  120.    PRINT " HIT ANY KEY to proceed onto the HELP screen...";
  121.    GOSUB GetChar
  122.  
  123.    DIM x%(5 * MaxNumPoints), y%(5 * MaxNumPoints)
  124.    REM MAP coordinates               **** THESE ARE BIGGER THAN APRS ***
  125.    DIM LN$(MaxNumLines) ' (no limit in APRS)  **** SO YOU CAN MANIPULATE BIG MAPS
  126.    nn = 2 * MaxNumLABELS
  127.    DIM ML$(nn), MLa(nn), MLo(nn), MLr(nn) 'Map Labels, lengths and coordinates
  128.    nn = 2 * MaxNumMAPS
  129.    DIM MapName$(nn), LATcen(nn), LONcen(nn), MapMax(nn), Comment$(nn)
  130.    RdsOn = -1: Labls = -1: Tags = -1: KP = 1: Changed = 0: MapSize = 256
  131.    i = 1000
  132.    DIM HLAT(i), HLONG(i)'For lat/longs from big GPS history files
  133.  
  134. INIT: ON ERROR GOTO ErrorTrap
  135.    ScrnType$ = "EGA": Ycen = 200: Yfactr = 1: YfacTXT = 350 / 350: SCREEN 9
  136.    IF ScrnType$ = "EGA" THEN COLOR 15, 0
  137.    REM ScrnType$ = "CGA": Yfactr=200/400:Ycen = 200*Yfactr: SCREEN 2
  138.    ReDraw = -1
  139.   
  140. Display$ = "HELP": GOSUB HELP: GOSUB LoadMap
  141. REM ON ERROR GOTO 0
  142.  
  143. Main: GOSUB DrwMPaCur
  144.   DO
  145. GoAgain: Fault = 0
  146.     IF Digitizer THEN
  147.          IF LOC(1) > 9 THEN
  148.             GOSUB GetXY: GOSUB Cursor
  149.             IF Btn <> 3 THEN GOSUB AddPoint
  150.          END IF
  151.     END IF
  152.     a$ = INKEY$
  153.     IF a$ <> "" THEN
  154.         a$ = UCASE$(a$): Key$ = a$
  155.         IF a$ = "S" THEN GOSUB labels
  156.         IF a$ = "L" THEN Labls = NOT Labls
  157.         IF a$ = "T" THEN Tags = NOT Tags
  158.         IF a$ = "F" THEN GOSUB FindPoint
  159.         IF a$ = "G" THEN GOSUB CurToPoint: GOSUB CurDrwMap
  160.         IF a$ = "H" THEN
  161.            IF Display$ <> "HELP" THEN
  162.               GOSUB HELP
  163.            ELSE GOSUB Info
  164.               LOCATE 25, 1: PRINT " H for HELP or SPACE BAR for map..."; : a$ = ""
  165.            END IF
  166.         END IF
  167.         IF a$ = "B" THEN GOSUB BoxPPD
  168.         IF a$ = "U" THEN GOSUB GetUSGS
  169.         IF a$ = "D" THEN GOSUB MapDIR
  170.         IF a$ = "M" THEN GOSUB ListMAPlist
  171.         IF a$ = "O" THEN GOSUB DrwAndShow
  172.         IF a$ = "N" THEN GOSUB NextLine: GOSUB Cursor
  173.         IF a$ = "P" THEN GOSUB Previous: GOSUB Cursor
  174.         IF a$ = "Q" THEN GOSUB QUIT
  175.         IF a$ = "R" THEN Z = 2: LNptr = 1
  176.         IF a$ = "T" THEN GOSUB Scrunch
  177.         IF a$ = " " THEN Display$ = "MAP": ReDraw = -1: USGS = 0: GOSUB DrwMPaCur
  178.         IF a$ = "+" THEN Z = Z + 1: GOSUB MapPoint ' moves to next map point
  179.         IF a$ = "-" THEN Z = Z - 1: GOSUB MapPoint ' moves backwards
  180.         IF a$ = CHR$(18) THEN ReDraw = NOT ReDraw: GOSUB ReDraw
  181.        
  182.         B$ = "": IF LEN(a$) = 2 THEN B$ = RIGHT$(a$, 1): REM process arrow & special keys
  183.         IF B$ = "I" THEN RS = RS * 2: GOSUB CurDrwMap: REM change scale
  184.         IF B$ = "Q" THEN RS = RS / 2: GOSUB CurDrwMap
  185.         IF B$ = CHR$(132) THEN RS = RS * 8: GOSUB CurDrwMap: REM change scale by factor of 4
  186.         IF B$ = "V" THEN RS = RS / 8: GOSUB CurDrwMap
  187.         IF B$ = "G" THEN GOSUB CurDrwMap 'Home key
  188.         IF a$ = "7" THEN CDX = LONo: CDY = LATo: GOSUB DrwMPaCur 'ShiftHOME
  189.         IF B$ = "O" THEN CDX = LONcen: CDY = LATcen: GOSUB DrwMPaCur 'End Key
  190.         IF B$ = "M" THEN CPX = CPX - 4 / (Sfac): GOSUB Cursor
  191.         IF B$ = "K" THEN CPX = CPX + 4 / (Sfac): GOSUB Cursor
  192.         IF B$ = "H" THEN CPY = CPY + 4 / (Sfac): GOSUB Cursor
  193.         IF B$ = "P" THEN CPY = CPY - 4 / (Sfac): GOSUB Cursor
  194.         REM Here are the special MapFIx routines
  195.         IF B$ = CHR$(30) THEN GOSUB AddPoint               'alt-ADD point
  196.         IF B$ = CHR$(48) AND Digitizer THEN GOSUB NewFeature'alt-BEGIN
  197.         IF B$ = CHR$(34) THEN GOSUB LoadHst                'alt-GPS hstry file
  198.         IF B$ = CHR$(50) THEN GOSUB MakePT: IF ReDraw THEN GOSUB DrawMap 'MOVE point to cursor
  199.         IF B$ = CHR$(32) THEN GOSUB DelPT                  'alt-DELete point
  200.         IF B$ = CHR$(38) THEN GOSUB AddLabel               'alt-ADD LABEL
  201.         IF B$ = CHR$(46) THEN GOSUB NewCenter              'alt-CENTER
  202.         IF B$ = CHR$(36) THEN GOSUB Join                   'alt-JOIN
  203.         IF B$ = CHR$(37) THEN GOSUB KillF                  'alt-KILL Feature
  204.         IF B$ = CHR$(19) THEN GOSUB MapRange               'alt-RANGE
  205.         IF B$ = CHR$(20) THEN GOSUB TRIM                   'alt-TRIM
  206.         IF B$ = CHR$(49) THEN GOSUB NewFeature             'alt-NEW Feature
  207.         IF B$ = CHR$(24) THEN GOSUB DigiInit: GOSUB DrawMap'alt-OPEN dgtzr COM
  208.         IF B$ = CHR$(31) THEN GOSUB Scrunch                'alt-SCRUNCH
  209.         IF B$ = CHR$(22) THEN GOSUB GetUSGS                'alt-U
  210.         IF B$ = CHR$(61) THEN                              'F3 for smaller Maps
  211.            MapSize = MapSize / 2: IF MapSize < 1 THEN MapSize = 1
  212.            GOSUB ShowMaps
  213.            END IF
  214.         IF B$ = CHR$(62) THEN                              'F4 for larger Maps
  215.            MapSize = MapSize * 2: IF MapSize > 1000 THEN MapSize = 1000
  216.            GOSUB DrwAndShow
  217.         END IF
  218.         IF a$ = CHR$(19) THEN GOSUB SaveMap
  219.            
  220.         IF a$ = "6" THEN CPX = CPX - 20 / (Sfac): GOSUB Cursor'SHIFT Cursor by 4
  221.         IF a$ = "4" THEN CPX = CPX + 20 / (Sfac): GOSUB Cursor
  222.         IF a$ = "8" THEN CPY = CPY + 20 / (Sfac): GOSUB Cursor
  223.         IF a$ = "2" THEN CPY = CPY - 20 / (Sfac): GOSUB Cursor
  224.         
  225.     END IF
  226.   LOOP
  227.   SYSTEM 'you should never get here
  228.  
  229. ReDraw: LOCATE 1, 30
  230.         IF ReDraw THEN PRINT "REDRAW ENABLED":  ELSE PRINT "NO ReDraw...  "
  231.         RETURN
  232.  
  233. QUIT: a$ = "Y"
  234.       IF Changed THEN
  235.          GOSUB BoxLine23
  236.          PRINT "**** MAP HAS BEEN MODIFIED"; Changed; "TIMES BUT NOT SAVED!!!  SAVE NOW? (Y)";
  237.          INPUT a$
  238.       IF UCASE$(a$) <> "N" THEN GOSUB SaveMap
  239.       END IF
  240.       SYSTEM
  241.  
  242. TRIM: GOSUB BoxLine23
  243.       CLS : PRINT "TRIM ALL POINTS AND LABELS OUTSIDE OF MAPRANGE"
  244.       PRINT
  245.       PRINT "This command will remove all points and labels that are outside of the white"
  246.       PRINT "map border.  You can change the location of this map border by using"
  247.       PRINT "the CENTER command (alt-C) and by changing the RANGE using alt-R."
  248.       PRINT : PRINT
  249.       PRINT "No map feature will be completely eliminated..."
  250.       PRINT
  251.       PRINT "The first and last point of any FEATURE will be retained, so the"
  252.       PRINT "result will be long single lines for all FEATURES outside the map border."
  253.       PRINT "Use the KILL FEATURE (alt-K) to eliminate those lines and use the MOVE"
  254.       PRINT "command (alt-M) to move any far away points closer to the border."
  255.       PRINT : PRINT
  256.       PRINT "You might consider stopping now and doing a SAVE (ctrl-S) before proceeding."
  257.       PRINT
  258.       PRINT "ALSO, THIS DOES NOT WORK FOR POINTS WITH NEGATIVE VALUES!  Be sure  your"
  259.       PRINT "selected area is below and to right of ORIGIN.  If not, run MAPCNVRT.bas."
  260.       PRINT : PRINT
  261.       INPUT "Are you ready to proceed? (Y/N) (N)"; ans$
  262.       GOSUB DrawMap
  263.       IF UCASE$(ans$) <> "Y" THEN RETURN
  264.       C = 0: LOCATE 23, 1: PRINT "Processing...";
  265.       REM dx and dy are num pix of center of map
  266.       REM bx and by are borders of map based on MapRng
  267.       by = ppdV * MapRng / 60
  268.       bx = by / Lfac
  269.       FOR Z = 1 TO nmp - 4
  270.          IF x%(Z) = 0 THEN Z = Z + 2
  271.          IF x%(Z) > dx + bx OR y%(Z) > dy + by THEN bad = 1 ELSE bad = 0
  272.          IF x%(Z) < dx - bx OR y%(Z) < dy - by THEN bad = 1
  273.          IF bad AND x%(Z - 1) <> 0 AND x%(Z + 1) <> 0 THEN
  274.             GOSUB DelPT: Z = Z - 1
  275.             C = C + 1
  276.          END IF
  277.       NEXT Z
  278.       LOCATE 23, 1: PRINT "Now removing labels...";
  279.       FOR i = 1 TO nml: REM now eliminate all labels outside
  280.           bad = 0: Xm = MapRng / (60 * Lfac): Ym = MapRng / 60
  281.           IF MLo(i) > LONcen + Xm OR MLa(i) > LATcen + Ym THEN bad = 1
  282.           IF MLo(i) < LONcen - Xm OR MLa(i) < LATcen - Ym THEN bad = 1
  283.           IF bad = 1 THEN
  284.              FOR j = i TO nml
  285.                  ML$(j) = ML$(j + 1): MLa(j) = MLa(j + 1)
  286.                  MLo(j) = MLo(j + 1): MLr(j) = MLr(j + 1)
  287.              NEXT j: nml = nml - 1: PRINT ".";
  288.           END IF
  289.       NEXT i
  290.       GOTO DrawMap
  291.  
  292.  
  293. FindPoint: CurX = INT(.5 + dx + (CUX - 320) / KP)
  294.            CurY = INT(.5 + dy + (CUY - Ycen) / KP)
  295.     GOSUB BoxLine23: PRINT "SEARCHING THROUGH ALL POINTS IN FILE...";
  296.     FOR j = 0 TO 30             ' Go through abt 20 times lookin pt.
  297.         IF j > 10 THEN j = j + 1' first with 0 delta, then bigger
  298.         LNctr = 0: PRINT ".";
  299.         FOR i = 1 TO nmp
  300.             IF x%(i) = 0 THEN LNctr = LNctr + 1
  301.             IF x%(i) > CurX - j AND x%(i) < CurX + j THEN
  302.                IF y%(i) > CurY - j AND y%(i) < CurY + j THEN
  303.                   Z = i: LNptr = LNctr: GOSUB CurToPoint
  304.                   j = 99: i = nmp
  305.                END IF
  306.             END IF
  307.         NEXT i:
  308.     NEXT j
  309.     IF j < 99 THEN PRINT "None found!": RETURN
  310.     GOSUB MapPoint: SavClr = 0: RETURN
  311.                   
  312. NewFeature: LOCATE 24, 1: PRINT SPACE$(27); : GOSUB BoxLine23
  313.             INPUT "Enter reference name for new feature"; a$
  314.             IF a$ = "" THEN RETURN
  315.             LOCATE 25, 1
  316.             FOR i = 0 TO 14
  317.             PRINT RIGHT$(" " + MID$(STR$(i + 1), 2), 2); "   ";
  318.             LINE (16 + i * 40, 335 * YfacTXT)-(40 + i * 40, 349 * YfacTXT), i + 1, BF
  319.             NEXT i
  320.             GOSUB BoxLine23
  321.             INPUT "Select color (4,7,10-Hwys 11-Water 12-Hwy 13-Spcl 14-City)"; B$
  322.             SavClr = VAL(B$): IF SavClr > 15 OR SavClr < 1 THEN RETURN
  323.             GOSUB BeginF
  324.             GOSUB BoxLine23: LOCATE 25, 1: PRINT SPACE$(80); : LOCATE 25, 1
  325.             IF RIGHT$(Key$, 1) = CHR$(48) THEN
  326.                PRINT "NOW USE DIGITIZER TO ADD NEW POINTS TO THIS FEATURE...";
  327.                GOSUB GetXY: GOSUB Cursor
  328.             ELSE
  329.                PRINT "NOW MOVE CURSOR AND USE ALT-A TO ADD POINTS TO THIS NEW FEATURE...";
  330.             END IF
  331.             GOSUB MakePT
  332.             RETURN
  333.            
  334. BeginF: x%(nmp) = 0: y%(nmp) = SavClr   'Store feature color 0,c
  335.         LN$(LNi + 1) = LN$(LNi): LNptr = LNi'Bump up present LN$ comment
  336.         LN$(LNi) = a$: LNi = LNi + 1'Store feature name
  337.         nmp = nmp + 1: Z = nmp
  338.         nmp = nmp + 1: x%(nmp) = 0: y%(nmp) = 0'nmp points to ending 0,0
  339.         RETURN
  340.  
  341. CanclF: nmp = nmp - 2: Z = Kz
  342.         LNi = LNi - 1: LN$(LNi) = LN$(LNi + 1): RETURN
  343.  
  344. NewCenter: LATcen = CPY: LONcen = CPX: Changed = Changed + 1: GOTO CurDrwMap
  345.  
  346. MapRange: GOSUB BoxLine23: INPUT "Enter map range"; a$
  347.           IF VAL(a$) <> 0 THEN MapRng = VAL(a$)
  348.           Changed = Changed + 1: GOTO DrwMPaCur
  349.  
  350. AddPoint: nmp = nmp + 1: Z = Z + 1
  351.           FOR i = nmp TO Z STEP -1
  352.               x%(i) = x%(i - 1): y%(i) = y%(i - 1)
  353.           NEXT
  354.           GOSUB MakePT
  355.           IF SavClr = 0 AND ReDraw THEN GOTO DrawMap
  356.           s = Z - 1: LineColor = SavClr: GOTO DP
  357.  
  358. MakePT: x%(Z) = dx + (CUX - 320) / (KP * Hfac)
  359.         y%(Z) = dy + (CUY - Ycen) / KP
  360.         Changed = Changed + 1
  361.         GOTO MapPoint
  362.  
  363. CurToPoint:
  364.      CPX = CDX - (x%(Z) - dx) / ppdV
  365.      CPY = CDY - (y%(Z) - dy) / (ppdV * Yfactr)
  366.      GOTO Cursor
  367.  
  368. DelPT: GOSUB DelZ
  369.        REM if 1st pt, it stays as 1st pt
  370.  
  371.        IF x%(Z) = 0 THEN Z = Z - 1: REM if end pt, it stays as end
  372.        IF x%(Z + 1) = 0 AND x%(Z - 1) = 0 THEN 'It is LAST point
  373.           GOSUB Kline: LNptr = LNptr - 1       'So Kill Line
  374.           GOSUB DelZ                           'And Kiil it
  375.           Z = Z - 1: GOSUB DelZ: Z = Z - 1     'Kill 0,color
  376.        END IF                                  'and -1 to end point
  377.        IF B$ = CHR$(32) AND ReDraw THEN GOSUB DrawMap ELSE GOSUB MapPoint
  378.        RETURN
  379.  
  380. DelZ: nmp = nmp - 1
  381.       FOR i = Z TO nmp
  382.           x%(i) = x%(i + 1): y%(i) = y%(i + 1)
  383.       NEXT: Changed = Changed + 1: RETURN
  384.  
  385. NextLine: IF Z >= nmp - 1 THEN Z = nmp - 1: BEEP: RETURN
  386.           DO UNTIL x%(Z) = 0: Z = Z + 1: LOOP
  387.           IF Z < nmp - 1 THEN Z = Z + 1: LNptr = LNptr + 1
  388.           SavClr = 0: GOTO MapPoint
  389. Previous: DO UNTIL Z = 1 OR x%(Z) = 0: Z = Z - 1: LOOP
  390.           IF Z > 3 THEN Z = Z - 1: LNptr = LNptr - 1
  391.           SavClr = 0: GOTO MapPoint
  392.  
  393. KillF: Bi = Z: Changed = Changed + 1
  394.        DO UNTIL x%(Bi) = 0: Bi = Bi - 1: LOOP: Z = Bi + 1
  395.        REM Stop at Beginning (0) point of the feature to kill
  396.        ni = Bi + 1' Now scan for next feature
  397.        DO UNTIL x%(ni) = 0: ni = ni + 1: LOOP
  398.        REM now move down rest of array to fill
  399.        DO UNTIL ni = nmp + 1
  400.            x%(Bi) = x%(ni): y%(Bi) = y%(ni)
  401.            Bi = Bi + 1: ni = ni + 1
  402.        LOOP
  403.        nmp = nmp - (ni - Bi): y%(nmp) = 0
  404.        GOSUB Kline
  405.        GOTO DrawMap
  406.      
  407. Kline: FOR i = LNptr TO LNi
  408.            LN$(i) = LN$(i + 1)
  409.            NEXT i
  410.            LNi = LNi - 1
  411.            RETURN
  412.  
  413. MapPoint:
  414.      IF Z < 2 THEN Z = 2: LNptr = 1: BEEP: SavClr = 0
  415.      IF Z > nmp - 1 THEN Z = Z - 1: BEEP: SavClr = 0
  416.      IF x%(Z) = 0 THEN
  417.         IF a$ = "-" THEN
  418.              LNptr = LNptr - 1: Z = Z - 1
  419.         ELSE LNptr = LNptr + 1: Z = Z + 1
  420.         END IF: SavClr = 0
  421.      END IF
  422.      IF LNptr < 0 THEN LNptr = 0
  423.      IF Display$ = "MAP" THEN
  424.           LOCATE 22, 1
  425.           PRINT "Fture#"; LNptr; TAB(12); LEFT$(LN$(LNptr) + "            ", 12);
  426.      END IF
  427. DrwMpPt: IF Display$ <> "MAP" THEN RETURN
  428.      CIRCLE (Xtest, Ytest), 10, 0 'Erase old circle
  429.      Xtest = 320 + KP * (x%(Z) - dx) * Hfac
  430.      Ytest = Ycen + KP * (y%(Z) - dy) * Yfactr
  431.      CIRCLE (Xtest, Ytest), 10, 15
  432.      
  433.      LOCATE 23, 1: PRINT "MapPt#"; Z;
  434.      IF Z > 999 THEN PRINT TAB(13); "val:";  ELSE PRINT TAB(12); "vals:";
  435.      PRINT TAB(17); x%(Z); TAB(23); y%(Z)
  436.      RETURN
  437.  
  438. AddLabel: nml = nml + 1
  439.           MLa(nml) = CPY: MLo(nml) = CPX
  440.           GOSUB BoxLine23: INPUT "Enter Label Name"; a$: ML$(nml) = a$
  441.           GOSUB BoxLine23: INPUT "Begin displaying label at what range?"; a$
  442.           a = VAL(a$): IF a <> 0 THEN MLr(nml) = a:  ELSE MLr(nml) = 2048
  443.           Changed = Changed + 1: GOTO labels
  444.  
  445. BoxLine23: LOCATE 23, 1: PRINT SPACE$(80); : LOCATE 23, 1: RETURN
  446.  
  447. ErrorTrap: Fault = ERR: 'Error handling routine
  448.            IF ERR = 57 THEN PRINT "  I/O-error-User-logoff"; : RESUME
  449.            IF ERR = 69 THEN PRINT "  Comm-buffer-overflow"; : RESUME
  450.            IF ERR = 53 THEN PRINT "  file-"; F$; "-not-found": CLOSE : RESUME NEXT
  451.            IF ERR = 62 THEN RESUME NEXT
  452.            IF ERR = 52 THEN RESUME NEXT
  453.            IF ERR = 55 THEN RESUME NEXT
  454.            IF ERR = 2 THEN PRINT "SYNTAX-error"
  455.            IF ERR = 70 THEN PRINT " WRITE PROTECTED!...": RESUME NEXT
  456.            IF ERR = 76 THEN PRINT "Wrong Path!": RESUME NEXT
  457.            RESET
  458.            PRINT : PRINT "Error beyond repair. Number = "; ERR;
  459.            INPUT "Hit RETURN to return to DOS"; a$
  460.            SYSTEM
  461.  
  462. MapDIR: CLS : PRINT "MAP FILES DIRECTORY": PRINT
  463.          PRINT "To display MAP files, please enter the path to your xxxxxxx.MAP files."
  464.          PRINT "For example, the default '\APRS\MAPS\*.MAP' will show all maps in the APRS"
  465.          PRINT "directory.  Similarly '*.map' will search your present QB directory."
  466.          PRINT "For any other path, enter the full file specification.": PRINT
  467.          F$ = "\aprs\MAPS\*.map"
  468.          PRINT "Enter Filespec for searching the DIRECTORY ("; F$; ")";
  469.          INPUT a$: IF a$ <> "" THEN F$ = a$
  470.          PRINT : PRINT : FILES F$
  471.          RETURN
  472.  
  473.  
  474. LoadMap: 'Maps are drawn to the default EGA resolution of 640 x 400 (350)
  475. Again: GOSUB BoxLine23
  476.        INPUT " Enter map FILENAME, or NEW, or ? for a list, or Q to quit)"; a$
  477.        a$ = UCASE$(a$): IF a$ = "" THEN GOTO Again
  478.        IF a$ = "Q" THEN SYSTEM
  479.        IF a$ = "?" THEN GOSUB MapDIR: GOTO Again
  480.        IF a$ = "NEW" THEN Key$ = "NEW": GOSUB NewMap: RETURN
  481.        a = INSTR(3, a$, "."): IF a = 0 THEN a$ = a$ + ".MAP"
  482.        MapFile$ = a$: F$ = MapFile$: OPEN F$ FOR INPUT AS #3
  483.        IF Fault = 53 THEN Fault = 0: PRINT : CLOSE #3: GOTO Again
  484.        GOSUB BoxLine23: PRINT " Loading "; F$; "..."
  485.        INPUT #3, LATo: LINE INPUT #3, LATtext$
  486.        INPUT #3, LONo: LINE INPUT #3, LONtext$
  487.        INPUT #3, ppdV: LINE INPUT #3, VS$'Pixels per degree horiz
  488.        INPUT #3, LATcen: LINE INPUT #3, LATcen$
  489.        INPUT #3, LONcen: LINE INPUT #3, LONcen$
  490.        INPUT #3, MapRng: LINE INPUT #3, MapRng$
  491.        INPUT #3, MinRng: LINE INPUT #3, MR$
  492.        LINE INPUT #3, TextLine$ ' Line of comments or instrutcitons
  493.        IF LEFT$(TextLine$, 14) = "Map generated " THEN ReDraw = 0
  494.        RS = 2 ^ INT(LOG(MapRng) / LOG(2))'Rng is intgr of VERTrng
  495.        i = 0: LNi = 0:
  496.      
  497.      DO WHILE NOT EOF(3)
  498.         i = i + 1: INPUT #3, x%(i), y: y%(i) = y * Yfactr
  499.         IF x%(i) = 0 AND NOT EOF(3) THEN ' Get line color & store with x=0
  500.            INPUT #3, y%(i): LNi = LNi + 1: LINE INPUT #3, LN$(LNi)' Save line name
  501.            IF y = -1 THEN GOSUB LoadLabels ' All labels listed at end of file
  502.            END IF
  503.         LOOP: nmp = i  'nmp points to 0,-1 that ends all data (but the value
  504.                        'of X% and y% are 0,0 until file is saved.
  505.      LET CDY = LATcen: CDX = LONcen'Center display on ORIGIN
  506.      LET CPX = CDX: CPY = CDY 'Cursor Posn to Center of Display
  507.      LET Z = 2: LNptr = 1: REM start at first point and first line segment
  508.      CLOSE #3: RETURN:     REM first X% value is map color.  2nd val is 1st pt
  509.  
  510.  
  511.  
  512. LoadLabels: k = 0
  513.      DO WHILE NOT EOF(3)
  514.         k = k + 1: INPUT #3, ML$(k), MLa(k), MLo(k), MLr(k)
  515.      LOOP
  516.      IF MLa(k) = 0 OR MLo(k) = 0 THEN nml = k - 1 ELSE nml = k
  517.      RETURN
  518.        
  519. SaveMap: GOSUB BoxLine23
  520.    PRINT "Enter file name to save if other than "; MapFile$;
  521.    INPUT a$: IF a$ <> "" THEN MapFile$ = a$
  522.    F$ = MapFile$
  523.    GOSUB BoxLine23: PRINT "Saving map to file named "; F$; " ..."
  524.    OPEN F$ FOR OUTPUT AS #4
  525.    IF Fault = 70 THEN CLOSE #4: GOTO SaveMap
  526.    PRINT #4, LATo; ","; LATtext$
  527.    PRINT #4, LONo; ","; LONtext$
  528.    PRINT #4, ppdV; ","; VS$
  529.    PRINT #4, LATcen; ","; LATcen$
  530.    PRINT #4, LONcen; ","; LONcen$
  531.    PRINT #4, MapRng; ","; MapRng$
  532.    PRINT #4, MinRng; ","; MR$
  533.    PRINT #4, TextLine$
  534.    j = 1
  535.    FOR i = 1 TO nmp
  536.        IF x%(i) <> 0 THEN WRITE #4, x%(i), INT((y%(i) / Yfactr) + .5)
  537.        IF x%(i) = 0 AND i = nmp THEN PRINT #4, " 0,-1"
  538.        IF x%(i) = 0 AND i <> nmp THEN
  539.           PRINT #4, "0,0"
  540.           PRINT #4, y%(i); ","; LN$(j): j = j + 1
  541.        END IF
  542.    NEXT i
  543.    PRINT #4, "0,"; LN$(LNi)
  544.    FOR k = 1 TO nml
  545.        PRINT #4, ML$(k); ","; : WRITE #4, MLa(k), MLo(k), MLr(k)
  546.    NEXT k: CLOSE #4: LOCATE 24, 1:
  547.    Changed = 0
  548.    IF nmp > MaxNumPoints OR nml > MaxNumLABELS THEN
  549.       CLS : LOCATE 9, 29: PRINT "CAUTION!": PRINT : PRINT
  550.       IF nmp > MaxNumPoints THEN
  551.          PRINT "            The number of points,"; nmp; "is greater than"; MaxNumPoints
  552.       END IF
  553.       IF nml > MaxNumLABELS THEN
  554.          PRINT "            The number of LABELS,"; nml; "is greater than"; MaxNumLABELS
  555.       END IF
  556.       LOCATE 18, 12
  557.       PRINT " Therefore this map will not work with APRS (yet) "
  558.       LOCATE 23, 1: INPUT "HIT Enter to continue..."; a$
  559.    END IF: GOTO DrwMPaCur
  560.  
  561. CurDrwMap: CDX = CPX: CDY = CPY: GOTO DrawMap: REM Re-center at CURSOR location
  562.  
  563. DrwMPaCur: CPX = CDX: CPY = CDY: GOSUB DrawMap
  564.            REM After drawing map, Put cursor at center
  565.            RETURN
  566.  
  567. DrawMap: IF USGS THEN RETURN
  568.     Display$ = "MAP": COLOR 15, 0
  569.    'Draw to range scale RS and center display CDX and CDY
  570.    'Original Map was 40 pix-per-deg Horiz and 20 vert for 200 display
  571.    'Now ppdH and ppdV are variables.  The scaling factor KP is 1 for
  572.    'the original map scale.
  573.    DO WHILE RS < 320 / ppdV: RS = RS * 2: LOOP
  574.    IF RS > 8192 THEN RS = 8192
  575.    KP = 100 * 100 / (RS * ppdV)'This is to scale it down from the 120 maps
  576.    Sfac = 50 * 200 / RS        'Till 307 had been 100*120
  577.  
  578.    Lfac = COS(CDY / 57.296)
  579.    Hfac = (640 / 350) * (3 / 4) * Lfac
  580.    dx = ppdV * (LONo - CDX)
  581.    dy = ppdV * (LATo - CDY)
  582.         
  583.    CLS : LOCATE 1, 2: PRINT "Redrawing Map"
  584.    REM first put ORIGIN and map CENTER on the map
  585.    LINE (320 - KP * dx, Ycen - KP * dy)-(960 - KP * dx, Ycen - KP * dy), 14
  586.    LINE (320 - KP * dx, Ycen - KP * dy)-(320 - KP * dx, 3 * Ycen - KP * dy), 14
  587.    CMX = 320 + Sfac * (CDX - LONcen) * Hfac'new
  588.    CMY = Ycen + Sfac * (CDY - LATcen) * Yfactr
  589.    LINE (CMX - 27, CMY)-(CMX + 27, CMY), 14
  590.    LINE (CMX, CMY - 20)-(CMX, CMY + 20), 14
  591.    CIRCLE (CMX, CMY), 10, 14
  592.    CIRCLE (320 - KP * dx, Ycen - KP * dy), 12, 14
  593.    s = 0: GOSUB MapPoint: REM Redraw MapPoint
  594.    StrtPt = -1
  595. DP: FOR i = s TO nmp - 1
  596.        x = 320 + KP * (x%(i) - dx) * Hfac
  597.        y = Ycen + KP * (y%(i) - dy) * Yfactr
  598.        X1 = 320 + KP * (x%(i + 1) - dx) * Hfac
  599.        Y1 = Ycen + KP * (y%(i + 1) - dy) * Yfactr
  600.        IF StrtPt = -1 THEN CIRCLE (x, y), 3, 9: StrtPt = 0
  601.        IF x%(i + 1) <> 0 THEN
  602.           IF RdsOn OR LineColor <> 12 THEN LINE (x, y)-(X1, Y1), LineColor
  603.           IF i = Z THEN SavClr = LineColor
  604.        ELSE
  605.           LINE (x - 3, y - 3)-(x + 3, y + 3), 10, B: StrtPt = -1
  606.           LineColor = y%(i + 1): i = i + 1
  607.           IF Display$ = "SHOW" AND LineColor > 8 THEN LineColor = LineColor - 8
  608.        END IF
  609.    NEXT i
  610.    GOSUB Cursor
  611.    GOSUB ReDraw
  612.    REM MapPoint went here
  613.    GOSUB DrawHist: REM draw GPS history track
  614.    IF Display$ = "SHOW" THEN
  615.       GOSUB ShowMaps
  616.    ELSE
  617.       LOCATE 25, 1: PRINT "Use +/- to move MAPpoint.  N/P for Next/Previous Feature.  H for HELP!.";
  618.       LOCATE 1, 61
  619.       PRINT "POINTS"; nmp; "= "; INT((nmp / MaxNumPoints) * 100); "%";
  620.       LOCATE 2, 61
  621.       PRINT "LABELS "; nml; "= "; INT((nml / MaxNumLABELS) * 100); "%";
  622.       LOCATE 3, 61: PRINT "CENTER  "; MID$(STR$(LATcen), 2, 5);
  623.       LOCATE 3, 75: PRINT MID$(STR$(LONcen), 2, 5)
  624.       LOCATE 4, 61: PRINT "SCALE   (ppd)"; ppdV
  625.       LOCATE 5, 69: PRINT "Range"; LEFT$(STR$(MapRng), 5)
  626.    END IF
  627.  
  628. labels:
  629.    IF Labls THEN
  630.       FOR i = 1 TO nml ' Now plot labels on map
  631.       IF RS <= MLr(i) OR Key$ = "S" THEN
  632.          LET x = 320 + Sfac * (CDX - MLo(i)) * Hfac'new
  633.          LET y = Ycen + Sfac * (CDY - MLa(i)) * Yfactr
  634.          IF Tags AND y > 14 * Yfactr AND y < 350 * Yfactr AND x > 8 * (LEN(ML$(i)) + 1) AND x < 632 THEN
  635.             LOCATE y / (14 * Yfactr), (x / 8) - LEN(ML$(i)): PRINT ML$(i);
  636.             END IF
  637.          END IF
  638.       NEXT i
  639.    END IF
  640.    GOSUB ShowMap: RETURN
  641.          
  642. ShowMap: REM this shows the map boarder of the loaded map
  643.     x = 320 + KP * (CDX - LONcen) * ppdV * Hfac'new
  644.     y = Ycen + KP * (CDY - LATcen) * ppdV * Yfactr
  645.       by = MapRng * Sfac * Yfactr / 60
  646.       bx = by * 640 / (400 * Yfactr) * Lfac'old
  647.       C = 15
  648.     LINE (x - bx, y - by)-(x + bx, y + by), C, B
  649.     RETURN
  650.  
  651. Cursor: CIRCLE (CUX, CUY), 4, 0
  652.      CUX = 320 + Sfac * (CDX - CPX) * Hfac'new
  653.      CUY = Ycen + Sfac * (CDY - CPY) * Yfactr
  654.      CIRCLE (CUX, CUY), 4, 14
  655.      x = INT(CPX): y = INT(CPY): Xm = (CPX - x) * 60: Ym = (CPY - y) * 60
  656.      x$ = RIGHT$(STR$(x), 3) + " "
  657.      LOCATE 1, 2: PRINT "RNG"; RIGHT$("   " + STR$(RS), 4) + "      "
  658.      LOCATE 2, 2: PRINT "LAT "; y; MID$(STR$(Ym) + "   ", 2, 5)
  659.      LOCATE 3, 2: PRINT "LON "; x$; MID$(STR$(Xm) + "   ", 2, 5)
  660.     
  661.      LOCATE 24, 1: PRINT "Cursor coordnts:"; TAB(17);
  662.      PRINT INT(.5 + dx + (CUX - 320) / KP); TAB(23); INT(.5 + dy + (CUY - Ycen) / KP);
  663.      REM LOCATE 24, 55: PRINT "Degrees: ";
  664.      REM PRINT LEFT$(STR$(CPY) + " ", 7); LEFT$(STR$(CPX) + "   ", 7);
  665.      LOCATE 1, 16: PRINT "Decimal";
  666.      LOCATE 2, 15: PRINT LEFT$(STR$(CPY) + " ", 8);
  667.      LOCATE 3, 15: PRINT LEFT$(STR$(CPX) + "   ", 8);
  668.      LINE (0, 0)-(178, 42 * Yfactr), 12, B'Box around it
  669.      LINE (0, 0)-(116, 42 * Yfactr), 12, B'Box around it
  670.      LET a$ = "": LET B$ = "": RETURN
  671.  
  672. HELP: CLS : COLOR 15, 1: LINE (0, 0)-(639, 18 * Yfactr), 14, BF
  673.       LOCATE 1, 20: PRINT " MAPFIX.bas HELP SCREEN Ver "; Ver$
  674.       LOCATE 3, 1
  675.       
  676.       PRINT " The cursor is shown in LAT/LON, map offset and decimal degrees.   The ORIGIN,"
  677.       PRINT " CENTER and BORDER are shown (but only the CENTER and RANGE in MAPLIST.map are"
  678.       PRINT " actually used by APRS.  Labels are right justified to the point just after the"
  679.       PRINT " last letter.  CALLS & OBJECT names will be left justified."
  680.       PRINT ""
  681.       PRINT " OPERATIONS          MAP FUNCTIONS         @N - NEW FEATURE   LABEL COMMANDS"
  682.       PRINT " H - HELP SCREENS    @C- Change CENTER     @A - ADD point     @S - SHOW labels"
  683.       PRINT "^S - SAVE MAP!!!     D - map DIRECTORY     @D - DELETE point  @L - add a LABEL"
  684.       PRINT " R - RESET pointers  M - MAPLIST.apr file  @K - Kill feature   L - LABELS off"
  685.       PRINT " Q - QUIT            O - OTHER map bordrs  @M - MOVE point"
  686.       PRINT "                     @R- set map RANGE     @T - TRIM borders"
  687.       PRINT "                                               "
  688.       PRINT " MAP COMMANDS        POINTER MOVEMENTS   USGS CD ROM CMDS   DIGITIZER & GPS "
  689.       PRINT " SPACE to draw map   N - Next Feature    B - BOX PPD area   @O- OPEN COMMS"
  690.       PRINT " ARROWS  (shft)      P - Prev Feature    U - USGS overlay   @B- BEGIN new line"
  691.       PRINT " PgUP/DN (ctrl)      G - Go to Pointer   T - Test smoother "
  692.       PRINT " HOME to Cursor      F - Find point      @S- SMOOTH file"
  693.       PRINT " END to map center   +/- move POINTER    @U- USGS BUILD!    @G- GPS OVERLAY"
  694.       PRINT "                                         @J- JOIN lines"
  695.       PRINT "                                         ^R- REDRAW on/off"
  696.       PRINT : LINE (0, 190 * Yfactr)-(639, 190 * Yfactr), 15
  697.               
  698.       IF Display$ <> "HELP" THEN
  699.        LOCATE 25, 1
  700.        PRINT " HIT H AGAIN FOR MORE HELP SCREENS, OR SPACE BAR FOR MAP...";
  701.       END IF
  702.       Display$ = "HELP"
  703.       LINE (0, 0)-(634, 348 * Yfactr), 15, B
  704.       RETURN
  705.  
  706.  
  707.  
  708. REM ************* HERE IS THE CODE BROUGHT IN FROM APRS  ***************
  709.  
  710. LdMapLst: GOSUB BoxLine23: INPUT "FileSpec for MAPLIST.apr if not \APRS\MAPLIST.APR"; a$
  711.           IF a$ <> "" THEN F$ = a$ ELSE F$ = "\aprs\Maplist.apr"
  712.           OPEN F$ FOR INPUT AS #3: IF Fault <> 0 THEN RETURN
  713.           i = 1: NumGood = 0
  714.           INPUT #3, DfltY: LINE INPUT #3, a$
  715.           INPUT #3, DfltX: LINE INPUT #3, a$
  716.           INPUT #3, BestRng: LINE INPUT #3, a$: DfltR = BestRng
  717.           INPUT #3, GMToffset: LINE INPUT #3, a$
  718.     WHILE a$ <> "* BEGIN *": LINE INPUT #3, a$: WEND ' Skip comment block
  719.           REM RS = BestRng: REM center display
  720.           REM RS = 2 ^ INT(LOG(RS) / LOG(2))'Rng is intgr power of 2
  721.           REM CPX = CDX: CPY = CDY 'Cursor Posn to Center of Display
  722.     WHILE NOT EOF(3) AND i <= UBOUND(MapName$)
  723.           INPUT #3, MapName$(i), LATcen(i), LONcen(i), MapMax(i)
  724.           LINE INPUT #3, Comment$(i)' IGNORE ALL comment fields
  725.           REM now ignore maps that start with a *
  726.           IF LEFT$(MapName$(i), 1) <> "*" THEN NumGood = NumGood + 1
  727.           NumMaps = i: i = i + 1
  728.     WEND: CLOSE #3
  729.     IF NumGood >= MaxNumMAPS - 1 THEN
  730.           CLS : LOCATE 2, 5
  731.           PRINT "WARNING: Too many ACTIVE MAPS (more than"; MaxNumMAPS; ") in MAPLIST.map file for APRS"
  732.           LOCATE 4, 10: PRINT "Use EDITOR to suppress mapnames with an (*) that you don't need."
  733.           PRINT : PRINT : PRINT : MapListLoaded = -1
  734.           INPUT "HIT RETURN to continue"; a$
  735.     END IF
  736.     RETURN
  737.  
  738. ListMAPlist: IF NOT MapListLoaded THEN GOSUB LdMapLst
  739.    GOSUB ListHeader
  740.    FOR i = 1 TO NumMaps
  741.        IF i / 19 = INT(i / 19) THEN
  742.           LOCATE 25, 1: PRINT "HIT RETURN to continue"; : INPUT a$
  743.           GOSUB ListHeader
  744.        END IF
  745.        PRINT MapName$(i); TAB(14);
  746.        PRINT INT(LATcen(i) * 100) / 100; TAB(21); INT(LONcen(i) * 100) / 100;
  747.        PRINT TAB(29); MapMax(i); TAB(36); LEFT$(LTRIM$(Comment$(i)), 43)
  748.    NEXT i
  749.    
  750.    LOCATE 25, 1: PRINT "LIST COMPLETE. CONTINUE WITH NEXT MAPFIX COMMAND...";
  751.    RETURN
  752.  
  753. ListHeader: CLS
  754.    PRINT "MAPS in MAPLIST.map (*MAPS are suppressed)     [For now, use EDITOR to modify]"
  755.    PRINT :
  756.    PRINT "MAP NAME      LATcen LONcen  RANGE COmments"
  757.    PRINT "------------  ------ ------- ----- -------------------------------------------"
  758.    RETURN
  759.  
  760. DrwAndShow: IF NOT MapListLoaded THEN GOSUB LdMapLst
  761.             Display$ = "SHOW": GOSUB DrwMPaCur
  762.  
  763. ShowMaps: IF MapSize > RS / 2 THEN MapSize = RS / 2
  764.     LOCATE 25, 1: PRINT " Drawing all maps >"; MapSize;
  765.     PRINT "mi.  F3 to see smaller, F4 for bigger, SPACE to cancel.";
  766.     LINE (0, 336 * Yfactr)-(639, 349 * Yfactr), 14, B
  767.     FOR i = 1 TO NumMaps
  768.    
  769.     x = 320 + Sfac * (CDX - LONcen(i)) * Hfac
  770.     y = Ycen + Sfac * (CDY - LATcen(i)) * Yfactr
  771.       dy = MapMax(i) * Sfac * Yfactr / 60
  772.       dx = dy * 640 / (400 * Yfactr) * Lfac
  773.       C = 15
  774.       IF MapMax(i) > 32 THEN C = 14
  775.       IF MapMax(i) > 64 THEN C = 12
  776.       IF MapMax(i) > 128 THEN C = 11
  777.       IF MapMax(i) > 256 THEN C = 13
  778.           
  779.     IF MapMax(i) > MapSize THEN
  780.        LINE (x - dx, y - dy)-(x + dx, y + dy), C, B
  781.        IF y + dy > 14 * Yfactr AND y + dy < 350 * Yfactr THEN
  782.           IF x + dx > 8 * (LEN(MapName$(i)) + 1) AND x + dx < 632 THEN
  783.              LOCATE (y + dy) / (14 * Yfactr), (x + dx) / 8 - LEN(MapName$(i))
  784.              IF MapMax(i) > RS / 4 THEN PRINT MapName$(i);
  785.           END IF
  786.        END IF
  787.     END IF
  788.     NEXT i: RETURN
  789.         
  790. REM ******* here is the code added by W7KKE for overlyaying track histoiries
  791. 'This module retrieves GPS history files so you can check the accuracy of
  792. 'the map
  793.  
  794. Hstdir: CLS : PRINT "HISTORY FILES DIRECTORY": PRINT
  795.          PRINT "To display HST files, please enter the path to your xxxxxxx.HST files."
  796.          PRINT "For example, the default '\APRS\*.HST' will show all maps in the APRS"
  797.          PRINT "directory.  Similarly '*.hst' will search your present QBasic directory."
  798.          PRINT "For any other path, enter the full file specification.": PRINT
  799.          
  800.          PRINT "Enter Filespec for searching the DIRECTORY (\aprs\*.hst)";
  801.          INPUT F$: IF F$ = "" THEN F$ = "\aprs\*.hst"
  802.          IF INSTR(F$, ".") = 0 THEN F$ = F$ + ".HST"
  803.          PRINT : PRINT : FILES F$
  804.          RETURN
  805.  
  806. LoadHst: GOSUB BoxLine23
  807.        INPUT "Which history file to load (ENTER for list, Q to quit)"; F$
  808.        IF UCASE$(F$) = "Q" THEN RETURN
  809.        IF F$ = "" THEN GOSUB Hstdir: GOTO LoadHst
  810.        a = INSTR(3, F$, "."): IF a = 0 THEN F$ = F$ + ".hst"
  811.        Fault = 0: F$ = UCASE$(F$): OPEN F$ FOR INPUT AS #3
  812.    
  813.        IF Fault = 53 OR Fault = 62 THEN Fault = 0: RETURN
  814.        GOSUB BoxLine23: PRINT "Loading track history from "; F$
  815.        
  816.     DO WHILE NOT EOF(3)
  817.        i = i + 1
  818.        INPUT #3, a$
  819.        HLAT(i) = VAL(MID$(a$, 26, 2)) + (VAL(MID$(a$, 28, 5)) / 60)
  820.        HLONG(i) = VAL(MID$(a$, 35, 3)) + (VAL(MID$(a$, 38, 5)) / 60)
  821.        maxhist = i
  822.      LOOP
  823.      CLOSE #3: Histloaded = -1
  824.      GOSUB BoxLine23: PRINT "File loading is complete.  GPS data is plotted."
  825.      REM fall through...
  826.  
  827. DrawHist:  'put history track on map
  828.      IF Histloaded THEN
  829.         size = 3: IF RS < 2 THEN size = size * 2 / RS
  830.         FOR i = 1 TO maxhist
  831.             HMX = 320 + KP * (CDX - HLONG(i)) * ppdV * Hfac'new
  832.             HMY = Ycen + KP * (CDY - HLAT(i)) * ppdV * Yfactr
  833.             CIRCLE (HMX, HMY), size, 13
  834.         NEXT i
  835.      END IF
  836.      RETURN
  837.  
  838. NewMap: CLS : PRINT "BEGINNING A NEW MAP FROM SCRATCH...": PRINT
  839.    PRINT "All points in an APRS map are measured as an"
  840.    PRINT "offset to the right and down from an origin."
  841.    PRINT
  842.    INPUT "Enter the LATITUDE  of the ORIGIN in decimal degrees"; LATo
  843.    INPUT "Enter the LONGITUDE of the ORIGIN in decimal degrees"; LONo
  844.    PRINT
  845.    PRINT "Choose the number of pixels per degree to set the map scale:"
  846.    PRINT
  847.    PRINT "Approximate size    Range from center  Pixels/Deg"
  848.    PRINT "----------------    -----------------  ----------"
  849.    PRINT "Big state or region        250             120"
  850.    PRINT "Typical state              100             300"
  851.    PRINT "Several Counties            50             600"
  852.    PRINT "Typical VHF range           25            1200"
  853.    PRINT "City streets (7.5 min maps) 12            2400"
  854.    PRINT
  855.    INPUT "Enter desired Pixels/Deg"; ppdB
  856.    IF ppdB = 0 THEN GOTO NewMap
  857.    REM In following lines, 500 is half of 999 (maximum nominal value for pts)
  858.    LATcen = LATo - (500 * Yfactr / ppdB)
  859.    LONcen = LONo - (500 / ppdB)
  860.    GOSUB StartMap: ppdV = ppdB
  861.    CLS : PRINT "YOU ARE NOW READY TO DRAW A NEW MAP...": PRINT : PRINT
  862.    PRINT "A white border has been drawn around the maximum size permitted for this map"
  863.    PRINT
  864.    PRINT "USING CURSOR WITHOUT DIGITIZER:  Move coursor to starting point for a NEW"
  865.    PRINT "feature and hit ALT-N.  Then enter new feature name (for reference purposes)"
  866.    PRINT "and continue moving cursor to the next point and hit ALT-A to add more points."
  867.    PRINT "Continue in this fashion, using ALT-N whenever you want to begin a NEW feature."
  868.    PRINT
  869.    PRINT "USING A DIGITIZER:  First, use ALT-O once to OPEN the digitizer COM port.  Then"
  870.    PRINT "use ALT-B to BEGIN each new map feature.  Enter the name and color of the new"
  871.    PRINT "feature.  Then use the digitizer mouse to add more points."
  872.    PRINT : PRINT : PRINT
  873.    PRINT "Add LABELS on the map at the current cursor location by using the ALT-L key. "
  874.    PRINT
  875.    PRINT "When you are finished, be sure to SAVE the map using the CTRL-S command..."
  876.    PRINT : PRINT : PRINT
  877.    PRINT "FOR HELP, REMEMBER THE  H  KEY!"
  878.    PRINT : PRINT : PRINT "Hit ENTER to proceed..."; : INPUT a$
  879.    RETURN
  880.  
  881. StartMap: REM This called by NEW and in middle of USGS build
  882.    LATcen$ = "LAT of CENTER": LONcen$ = "LON of CENTER"
  883.    MapRng = 60 * 500 * Yfactr / ppdB: REM 500 is half of full map size
  884.    MapRng$ = "Map range from center"
  885.    VS$ = "Pixels per degree"
  886.    MinRng = 1: MR$ = "No longer used"
  887.    TextLine$ = "NEW Map generated by MAPFIX.bas routine..."
  888.    IF Key$ = "NEW" THEN RS = 2 ^ INT(LOG(MapRng) / LOG(2))'Rng is intgr of VERTrng
  889.    CDX = LONcen: CDY = LATcen: CPX = CDX: CPY = CDY
  890.    nmp = 1: nml = 0
  891.    LNi = 1: LN$(1) = "Labels begin here"
  892.    RETURN
  893.  
  894.  
  895. DigiInit: CLS : PRINT : Digitizer = -1
  896.    PRINT "This routine will replace many CURSOR functions with the Digitizer's MOUSE."
  897.    PRINT "Assuming your digitizer can output an X,Y,C format."
  898.    PRINT
  899.    PRINT "Only Mercator projection charts will give absolutely accurate results.  Other"
  900.    PRINT "types, Lambert Conformal, Conical, etc will induce distortions."
  901.    PRINT
  902.    PRINT "It has not been tested with East Longitude or South Latitude."
  903.    PRINT : PRINT
  904.    PRINT "The digitizr should operate at 9600,N,8,1 in POINT mode with 200 LPI resolution."
  905.    PRINT "The FORMAT outputs X,Y,C values separated by commas (C is for button pressed."
  906.    PRINT
  907.    PRINT "Set up the digitizer according to your model's instructions.  For the model"
  908.    PRINT "23360, use the drawing board menu by pressing the mouse button 0 on the SETUP"
  909.    PRINT "label so that the LED is ON.  Then move the mouse to each other label and"
  910.    PRINT "use the 0 button to toggle the value ON or off as follows:"
  911.    PRINT
  912.    PRINT "POINT is ON                             PARITY 7/8 and 1 are ON "
  913.    PRINT "BAUDRATE 3 is ON                        FORMAT is ON ON off ON"
  914.    PRINT "DATA RATE doesn't matter                RESOLUTION off off ON"
  915.    PRINT : PRINT
  916.    INPUT "Is DIGITIZER connected to COM1 or COM2 (1)"; a$
  917.    IF a$ <> "2" THEN a$ = "COM1" ELSE a$ = "COM2"
  918.  
  919.    Port$ = a$ + ":9600,N,8,1,cs0,ds0,cd0"
  920.    OPEN Port$ FOR RANDOM AS #1
  921.    
  922.  
  923.    CLS : PRINT "FIRST LETS TEST THE DIGITIZER, AND GET THE MAP ON STRAIGHT.": PRINT
  924.    PRINT "Move your mouse (or pen) and hit the 0 button (or touch tablet) to see if the"
  925.    PRINT "digitizer is outputting in the desired format.  While doing this, it is a good"
  926.    PRINT "idea to verify that your map is on straight.  The Y values from the mouse"
  927.    PRINT "should give the same values for the same LATITUDE line on both the right and"
  928.    PRINT "left edges of the map.  If not, move your map to get it horizontal."
  929.    PRINT
  930.    PRINT "OUTPUT FORMAT:"
  931.    PRINT
  932.    PRINT "XXXXX,YYYYY,APn (Only the X and Y values are used (4 or 5 digits is ok)"
  933.    PRINT
  934.    LOCATE 25, 1: PRINT "Hit ENTER and press 0 button on mouse to continue...";
  935.    LOCATE 13, 1
  936.    DO UNTIL INKEY$ <> "": LINE INPUT #1, a$: PRINT a$: LOOP
  937.   
  938.    CLS : PRINT
  939.    PRINT "NEXT YOU MUST ESTABLISH THE SCALE OF YOUR DIGITIZER."
  940.    PRINT
  941.    PRINT "The scale is established by two points, the first near the"
  942.    PRINT "upper left corner, the second near the lower right corner."
  943.    PRINT
  944.    PRINT "To get the best accuracy on maps not exactly MERCATOR, use points within the "
  945.    PRINT "area where you are working, not on the extreme corners.  IE:  choose points"
  946.    PRINT "that are in the center of the upper left quadrant and the lower right quadrant."
  947.    PRINT
  948.    PRINT "To establish the upper left reference point:"
  949.    INPUT "     Enter lat  (deg,min)"; LATref1, M: LATref1 = LATref1 + M / 60
  950.    INPUT "     Enter long (deg,min)"; LONref1, M: LONref1 = LONref1 + M / 60
  951.    PRINT
  952.  
  953.    PRINT "Place the mouse on the upper left point and press the 0 button."
  954.    LINE INPUT #1, a$: SOUND 150, 3
  955.         digix1 = 5000 - VAL(LEFT$(a$, 5))
  956.         digiy1 = VAL(MID$(a$, 7, 5))
  957.         PRINT "Digitizer reads "; digix1, digiy1; " for this point.": PRINT
  958.  
  959.    PRINT "NOW Establish the lower right reference point:"
  960.    INPUT "      Enter lat  (deg,min)"; LATref2, M: LATref2 = LATref2 + M / 60
  961.    INPUT "      Enter long (deg,min)"; LONref2, M: LONref2 = LONref2 + M / 60
  962.    PRINT
  963.    PRINT "Place digitizer pen on lower right point."
  964.    LINE INPUT #1, a$: SOUND 150, 3
  965.         digix2 = 5000 - VAL(LEFT$(a$, 5))
  966.         digiy2 = VAL(MID$(a$, 7, 5))
  967.         PRINT "Digitizer reads "; digix2, digiy2; " for this point.": PRINT
  968.  
  969.    REM Find delta lat/long between reference points
  970.    REM Calculate degrees per x/y unit
  971.         degx# = (LONref1 - LONref2) / (digix1 - digix2)
  972.         degy# = (LATref1 - LATref2) / (digiy1 - digiy2)
  973.  
  974.    CLS : PRINT "YOU ARE NOW READY TO USE THE DIGITIZER TO ENTER POINTS INTO MAPFIX..."
  975.    PRINT
  976.    PRINT "The digitizer works just about like the cursor and arrow keys in MAPFIX.  Any"
  977.    PRINT "point identified by the digitizer will be ADDED just as if you had hit ALT-A."
  978.    PRINT "All points are added to a feature after the current MapPoint identified by the"
  979.    PRINT "white circle. "
  980.    PRINT
  981.    PRINT "With the digitizer, do NOT use the ALT-N NEW command which always begins at the"
  982.    PRINT "current cursor location.  For the digitizer, use ALT-B to BEGIN a new feature."
  983.    PRINT "You will be asked to identify the name and color of the new feature.  From then"
  984.    PRINT "on, just move the digitizer mouse (or pen) to ADD new points.  "
  985.    PRINT
  986.    PRINT "If your digitizer mouse has 4 buttons, use the first (left) button for ADDing "
  987.    PRINT "points, use the 4th (right) button to just move the cursor with no action."
  988.    PRINT : PRINT
  989.    INPUT "Hit ENTER to continue with MAPFIX..."; a$
  990.    RETURN
  991.  
  992. GetXY: LINE INPUT #1, a$: SOUND 150, 3
  993.        a = INSTR(a$, ","): IF a = 0 THEN RETURN
  994.            x = 5000 - VAL(LEFT$(a$, a - 1))
  995.        B = INSTR(a + 1, a$, ","): IF B = 0 THEN B = LEN(a$)
  996.        y = VAL(MID$(a$, a + 1, B - (a)))
  997.        Btn = VAL(RIGHT$(a$, 1))
  998.        CPY = ((y - digiy2) * degy#) + LATref2
  999.        CPX = ((x - digix2) * degx#) + LONref2
  1000.        IF LOC(1) <> 0 THEN a$ = INPUT$(LOC(1), #1)'Clear input buffer
  1001.        RETURN
  1002.  
  1003. BoxPPD: GOSUB BoxLine23: INPUT "Enter the desired PPD"; a$: ppdB = VAL(a$)
  1004.    dy = (30000 / ppdB) * Sfac * Yfactr / 60
  1005.    dx = dy * 640 / (400 * Yfactr) * Lfac
  1006.    GOSUB BoxLine23: LINE (CUX - dx, CUY - dy)-(CUX + dx, CUY + dy), 13, B
  1007.    PRINT "The box represents the largest APRS map that can be made with that scale."
  1008.    RETURN
  1009.         
  1010.  
  1011. GetUSGS: REM This used for both U=OVERLAY and by ALT-U = USGS BUILD!
  1012.    ReDraw = 0: USGS = -1: ni = 0: nt = 0: j = 0: NumLines = 0: LE = 1: OE = 1
  1013.    IF Key$ <> "U" THEN
  1014.       IF ppdB <> 0 THEN ppdV = ppdB
  1015.       LATo = CDY + (500 * Yfactr / ppdV)
  1016.       LONo = CDX + (500 / ppdV)
  1017.       GOSUB BoxLine23: PRINT "Improve LAT ORIGIN of "; LATo; : INPUT LATo
  1018.       GOSUB BoxLine23: PRINT "Improve LON ORIGIN of "; LONo; : INPUT LONo
  1019.       GOSUB BoxLine23: INPUT "LATitude extent (100%)"; a$
  1020.             IF a$ <> "" THEN LE = VAL(a$) / 100
  1021.       GOSUB BoxLine23: INPUT "LONgitude extent (100%)"; a$
  1022.             IF a$ <> "" THEN OE = VAL(a$) / 100
  1023.       dx = ppdV * (LONo - CDX)
  1024.       dy = ppdV * (LATo - CDY)
  1025.       KP = 100 * 100 / (RS * ppdV)
  1026.       LATcen = CDY: LONcen = CDX: GOSUB StartMap
  1027.       LATtext$ = "Decimal LATITUDE  of map ORIGIN"
  1028.       LONtext$ = "Decimal LONGITUDE of map ORIGIN"
  1029.       TextLine$ = "Map generated by MAPFIX from USGS 2,000,000:1 CD ROM (data valid mid-1980's)"
  1030.    END IF
  1031.    Lmax = 500 + 600 * LE: Lmin = 500 - 600 * LE 'Max=1100 and Min =-100
  1032.    Omax = 500 + 600 * OE: Omin = 500 - 600 * OE
  1033.    GOSUB BoxLine23: INPUT "Enter path and filename of XTRACTED USGS data file"; a$
  1034.    a = INSTR(a$, "."): IF a = 0 THEN a$ = a$ + ".GRF"
  1035.    OPEN a$ FOR INPUT AS #3
  1036.    IF Fault <> 0 THEN RETURN
  1037.    GOSUB BoxLine23: INPUT "Enter RANK cutoff. (all roads = 99) for ST and WB use 20, or 10"; a$
  1038.    MaxRnk = VAL(a$)
  1039.    REM PRINT "raw data format.....", "   LineID", "#-Rnk-Atbts", "  NumPts"
  1040.    LOCATE 5, 67: PRINT "RANGE: "; INT(30000 / ppdV): LOCATE 24, 1
  1041.    IF Key$ = "U" THEN
  1042.       PRINT "While USGS OVERLAYED, do not redraw map or you will have to do it again...";
  1043.    ELSE PRINT "Blue circles start lines, Green Box ends.  Red points discarded, Yellow Kept!";
  1044.    END IF
  1045.  DO UNTIL EOF(3) OR LNi = MaxNumLines - 1
  1046.    NumLines = NumLines + 1
  1047.    LOCATE 1, 61: PRINT "TOTAL POINTS: "; nt
  1048.    LOCATE 2, 61: PRINT "POINTS USED:  "; ni
  1049.    LOCATE 3, 61: PRINT "TOTAL LINEs:  "; NumLines
  1050.    LOCATE 4, 61: PRINT "LINEs USED:   "; LNi
  1051.    a$ = INPUT$(20, 3): REM PRINT a$;
  1052.         LnID$ = LEFT$(a$, 7)
  1053.         Rank$ = MID$(a$, 8, 2): Rank = VAL(Rank$): LOCATE 6, 67: PRINT "RANK: "; Rank
  1054.         Npts$ = MID$(a$, 10, 6): Npts = VAL(Npts$)
  1055.         AtCd$ = MID$(a$, 16, 5)
  1056.         a$ = LTRIM$(LnID$) + "-" + Rank$ + "-" + AtCd$
  1057.         REM PRINT , LnID$, a$, Npts$
  1058.    IF Rank < 24 THEN SavClr = 4 ELSE SavClr = 7
  1059.    IF Rank < 20 THEN SavClr = 12
  1060.    IF Rank < 14 THEN SavClr = 10
  1061.    LineOK = 0: IF Key$ <> "U" THEN GOSUB BeginF
  1062.    FOR i = 1 TO Npts
  1063.     a$ = INPUT$(20, 3): IF Rank > MaxRnk THEN GOTO Skp
  1064.     REM IF VAL(Rank$) > 99 THEN GOTO Skp
  1065.     LA = VAL(LEFT$(a$, 2)) + VAL(MID$(a$, 3, 2)) / 60 + VAL(MID$(a$, 5, 2)) / 3600
  1066.     LO = VAL(MID$(a$, 8, 3)) + VAL(MID$(a$, 11, 2)) / 60 + VAL(MID$(a$, 13, 2)) / 3600
  1067.     IF Key$ = "U" THEN
  1068.         REM Following lines used to limit points if just doing an OVERLAY only
  1069.         IF LA > CDY + RS / 60 OR LA < CDY - RS / 50 THEN GOTO Skp 'off screen
  1070.         IF LO > CDX + RS / 40 OR LO < CDX - RS / 40 THEN GOTO Skp
  1071.         REM s$ = MID$(a$, 16, 5)
  1072.         REM PRINT S$, LA, LO
  1073.         END IF
  1074.     y% = (LATo - LA) * ppdV: x% = (LONo - LO) * ppdV
  1075.     IF Key$ <> "U" AND (x% > Omax OR x% < Omin) THEN GOTO Skp'this ignores points off PPD
  1076.     IF Key$ <> "U" AND (y% > Lmax OR y% < Lmin) THEN GOTO Skp'scale
  1077.     LineOK = -1
  1078.        X1 = 320 + KP * (x% - dx) * Hfac
  1079.        Y1 = Ycen + KP * (y% - dy) * Yfactr
  1080.        IF i > 2 THEN
  1081.           REM LINE (x, y)-(X1, Y1), 6
  1082.           dd = LO - LOb: IF dd = 0 THEN dd = .0000001
  1083.           dn = LA - LAb
  1084.           s = dn / dd' Note that 1>s>.01 for Xdelta of 1 to 100
  1085.           IF ABS(s) < .1 AND ABS(Lsp) < .1 THEN
  1086.              sd = 1
  1087.           ELSEIF ABS(s) > 10 AND ABS(Lsp) > 10 THEN sd = 1
  1088.           ELSEIF ABS(dd) < .004 AND ABS(dn) < .004 THEN sd = 1
  1089.           ELSEIF s <> 0 THEN sd = Lsp / s
  1090.           ELSE sd = 0
  1091.           END IF
  1092.           IF sd > 2 OR sd < .5 OR i = Npts THEN
  1093.              CIRCLE (x, y), 1, 14
  1094.              IF Key$ <> "U" THEN GOSUB KeepLine
  1095.           ELSE CIRCLE (x, y), 1, 4
  1096.           END IF
  1097.           Lsp = s: nt = nt + 1
  1098.        ELSE Lsp = 0: CIRCLE (X1, Y1), 4, 9
  1099.           IF Key$ <> "U" THEN GOSUB KeepLine 'keeps first two lines
  1100.        END IF
  1101.        LAb = LA: LOb = LO
  1102.        x = X1: y = Y1
  1103.        
  1104. Skp: NEXT i
  1105.      IF Key$ <> "U" THEN
  1106.         IF LineOK THEN nmp = nmp - 1: Z = Z - 1: ni = ni + 1 ELSE GOSUB CanclF
  1107.      END IF
  1108.      LINE (x - 3, y - 3)-(x + 3, y + 3), 10, B ' Last Point
  1109.  LOOP
  1110.  IF LNi > MaxNumLines - 2 THEN LOCATE 12, 20: PRINT "PROCESSING STOPPED... TOO MANY LLINES!..."
  1111.    CLOSE #3
  1112.    RETURN
  1113.  
  1114. KeepLine: x%(Z) = x%: y%(Z) = y%: nmp = nmp + 1: Z = Z + 1: ni = ni + 1: RETURN
  1115.  
  1116.  
  1117. Scrunch: i = 0: Pt = 0: nt = 0: ni = 0: GOSUB BoxLine23
  1118.     INPUT "Enter slope filter ratio 1.2 to 5 (typically 1.5)"; a$
  1119.     IF a$ = "" THEN slope = 1.5 ELSE slope = VAL(a$)
  1120.     DO UNTIL i >= nmp - 1
  1121.        i = i + 1
  1122.        X1 = 320 + KP * (x%(i) - dx) * Hfac
  1123.        Y1 = Ycen + KP * (y%(i) - dy) * Yfactr
  1124.        IF x%(i) <> 0 THEN
  1125.           Pt = Pt + 1
  1126.           IF Pt > 2 THEN
  1127.              LINE (x, y)-(X1, Y1), 6
  1128.              dd = x - X1: IF dd = 0 THEN dd = .01
  1129.              dn = y - Y1
  1130.              dst = ((dd * dd) + (dn * dn)) ^ .5
  1131.              s = dn / dd' Note that 1>s>.01 for Xdelta of 1 to 100
  1132.              IF s = 0 THEN s = .05
  1133.              IF ABS(s) < .2 THEN s = .2 * SGN(s)
  1134.              IF ABS(s) > 5 THEN s = 5 * SGN(s)
  1135.              IF ABS(s) <= .2 AND ABS(Lsp) <= .2 THEN
  1136.                 sd = 1
  1137.              ELSEIF ABS(s) >= 5 AND ABS(Lsp) >= 5 THEN sd = 1
  1138.              ELSE sd = Lsp / s
  1139.              END IF
  1140.              IF ABS(dd) > 50 * KP OR ABS(dn) > 30 * KP THEN sd = 0
  1141.              REM IF ABS(dd) < 5 OR ABS(dn) < 4 THEN sd = 1
  1142.              IF sd > slope OR sd < 1 / slope OR x%(i + 1) = 0 OR NumRej > 4 THEN
  1143.                 ni = ni + 1: CIRCLE (x, y), 2, 14: NumRej = 0
  1144.                 
  1145.              ELSE CIRCLE (x, y), 1, 4: NumRej = NumRej + 1
  1146.                 IF Key$ <> "T" THEN
  1147.                    i = i - 1: nmp = nmp - 1
  1148.                    FOR ii = i TO nmp
  1149.                        x%(ii) = x%(ii + 1): y%(ii) = y%(ii + 1)
  1150.                    NEXT ii
  1151.                 END IF
  1152.              END IF
  1153.              Lsp = s: nt = nt + 1
  1154.           ELSE Lsp = 0: nt = nt + 1: ni = ni + 1: CIRCLE (X1, Y1), 4, 9
  1155.           END IF
  1156.        ELSE Pt = 0: nt = nt + 1: ni = ni + 1
  1157.           LOCATE 1, 61: PRINT "TOTAL POINTS: "; nt
  1158.           LOCATE 2, 61: PRINT "SAVED POINTS: "; ni
  1159.        END IF
  1160.        x = X1: y = Y1
  1161.     LOOP
  1162.     RETURN
  1163.  
  1164. Join: REM Search for end=begin point values and CONCATONATE if equal!
  1165.    LNptr = 0: i = 0: k = 0: GOSUB BoxLine23: PRINT "Lines joined: ";
  1166.    DO UNTIL i >= nmp
  1167.       i = i + 1
  1168.        IF x%(i) = x%(i + 2) AND y%(i) = y%(i + 2) AND y%(i + 1) = LColor THEN
  1169.           nmp = nmp - 2: LNi = LNi - 1: k = k + 1: LOCATE 23, 15: PRINT k
  1170.           FOR j = i + 1 TO nmp: x%(j) = x%(j + 2): y%(j) = y%(j + 2): NEXT j
  1171.           FOR j = LNptr TO LNi: LN$(j) = LN$(j + 1): NEXT j
  1172.        ELSEIF x%(i) = 0 THEN LColor = y%(i): LNptr = LNptr + 1
  1173.        END IF
  1174.    LOOP: GOTO DrawMap
  1175.  
  1176. END
  1177.  
  1178.